home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1997 / HAM Radio 1997.iso / vcls / rotate / myrotaed.pas < prev    next >
Pascal/Delphi Source File  |  1996-04-08  |  9KB  |  316 lines

  1. unit Myrotaed;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, MyRotate, ColorGrd,DsgnIntf, Spin,
  8.   ExtCtrls;
  9.  
  10. type
  11.    TLabelEditorDlg = class(TForm)
  12.     RBNormal: TRadioButton;
  13.     RBRaised: TRadioButton;
  14.     RBResit: TRadioButton;
  15.     RBShadowed: TRadioButton;
  16.     RBResetWhite: TCheckBox;
  17.     Label4: TLabel;
  18.     TheAngle: TScrollBar;
  19.     Degree: TLabel;
  20.     BitBtnOk: TBitBtn;
  21.     MyLabelRotate1: TMyLabelRotate;
  22.     BitBtnCancel: TBitBtn;
  23.     ShadeV: TSpinEdit;
  24.     Label2: TLabel;
  25.     ShadeH: TSpinEdit;
  26.     Label3: TLabel;
  27.     GroupBox1: TGroupBox;
  28.     MyLabelRotate2: TMyLabelRotate;
  29.     ByLabel: TLabel;
  30.     ShadowColors: TComboBox;
  31.     ShadowChoice: TRadioGroup;
  32.     procedure TheAngleScroll(Sender: TObject; ScrollCode: TScrollCode;
  33.       var ScrollPos: Integer);
  34.     procedure RBResetWhiteClick(Sender: TObject);
  35.     procedure ShadowColorsChange(Sender: TObject);
  36.     procedure RBNormalClick(Sender: TObject);
  37.     procedure RBRaisedClick(Sender: TObject);
  38.     procedure RBResitClick(Sender: TObject);
  39.     procedure RBShadowedClick(Sender: TObject);
  40.     procedure BitBtnCancelClick(Sender: TObject);
  41.     procedure ShadeVChange(Sender: TObject);
  42.     procedure ShadeHChange(Sender: TObject);
  43.     procedure MyLabelRotate1Click(Sender: TObject);
  44.      { Private declarations }
  45.    private
  46.     fAngle: longint;
  47.     FA3DEffect : T3DEffectShort;
  48.     FhOffSet,FvOffSet : integer;
  49.     FShadowColor,FWhiteColor : TColor;
  50.     FShadeLTSet : boolean;
  51.     FLabelStyle : TLabelStyle;
  52.     ColorValues : array[0..38] of TColor;
  53.     procedure DefaultColorPallet;
  54.     procedure SetTheAngle(Value: longint);
  55.     procedure setTheStyleEffect(Value : T3DEffectShort);
  56.     procedure SetTheShadowColor(Value:TColor);
  57.     procedure SetTheWhiteColor(Value:TColor);
  58.     procedure SetTheShadeLT(value: boolean);
  59.     procedure SetTheFhOffSet(value: integer);
  60.     procedure SetTheFvOffSet(value: integer);
  61.     procedure setTheLabelstyle(value:TLabelStyle);
  62.   public
  63.     { Public declarations }
  64.     property EditorLabelStyle : TLabelStyle read FLabelStyle write setTheLabelStyle;
  65.   end;
  66.  
  67.   TLabelStyleProperty = class(TClassProperty)
  68.   public
  69.     procedure Edit; override;
  70.     function GetAttributes: TPropertyAttributes; override;
  71.   end;
  72.  
  73.   TMyLabelRotateEditor = class(TDefaultEditor)
  74.   public
  75.     procedure EditProperty(PropertyEditor: TPropertyEditor;
  76.       var Continue, FreeEditor: Boolean); virtual;
  77.   end;
  78.  
  79. implementation
  80.  
  81. {$R *.DFM}
  82. procedure TLabelStyleProperty.Edit;
  83. var
  84.   Style: TLabelStyle;
  85.   LabelStyleEditor: TLabelEditorDlg ;
  86. begin
  87.   Style := TLabelStyle(GetOrdValue);
  88.   LabelStyleEditor := TLabelEditorDlg .Create(Application);
  89.   try
  90.     LabelStyleEditor.EditorLabelStyle := Style;
  91.     LabelStyleEditor.ShowModal;
  92.     Designer.Modified;
  93.   finally
  94.     LabelStyleEditor.Free;
  95.   end;
  96. end;
  97.  
  98. function TLabelStyleProperty.GetAttributes: TPropertyAttributes;
  99. begin
  100.   Result := [paDialog, paSubProperties, paAutoUpdate];
  101. end;
  102.  
  103. {TMyLabelRotateEditor}
  104.  
  105. procedure TMyLabelRotateEditor.EditProperty(PropertyEditor: TPropertyEditor;
  106.   var Continue, FreeEditor: Boolean);
  107. var
  108.   PropName: string;
  109. begin
  110.   PropName := PropertyEditor.GetName;
  111.   if (CompareText(PropName, 'LABELSTYLE') = 0) then
  112.   begin
  113.     PropertyEditor.Edit;
  114.     Continue := False;
  115.   end;
  116. end;
  117.  
  118. procedure TLabelEditorDlg.DefaultColorPallet;
  119. begin
  120.    ColorValues[0] := clBlack;
  121. ColorValues[1] := clMaroon;
  122. ColorValues[2] := clGreen;
  123. ColorValues[3] := clOlive;
  124. ColorValues[4] := clNavy;
  125. ColorValues[5] := clPurple;
  126. ColorValues[6] := clTeal;
  127. ColorValues[7] := clGray;
  128. ColorValues[8] := clSilver;
  129. ColorValues[9] := clRed;
  130. ColorValues[10] := clLime;
  131. ColorValues[11] := clYellow;
  132. ColorValues[12] := clBlue;
  133. ColorValues[13] := clFuchsia;
  134. ColorValues[14] := clAqua;
  135. ColorValues[15] := clWhite;
  136. ColorValues[16] := clLtGray;
  137. ColorValues[17] := clDkGray;
  138. ColorValues[18] := clScrollBar;
  139. ColorValues[19] := clBackground;
  140. ColorValues[20] := clActiveCaption;
  141. ColorValues[21] := clInactiveCaption;
  142. ColorValues[22] := clMenu;
  143. ColorValues[23] := clWindow;
  144. ColorValues[24] := clWindowFrame;
  145. ColorValues[25] := clMenuText;
  146. ColorValues[26] := clWindowText;
  147. ColorValues[27] := clCaptionText;
  148. ColorValues[28] := clActiveBorder;
  149. ColorValues[29] := clInactiveBorder;
  150. ColorValues[30] := clAppWorkSpace;
  151. ColorValues[31] := clHighlight;
  152. ColorValues[32] := clHighlightText;
  153. ColorValues[33] := clBtnFace;
  154. ColorValues[34] := clBtnShadow;
  155. ColorValues[35] := clGrayText;
  156. ColorValues[36] := clBtnText;
  157. ColorValues[37] := clInactiveCaptionText;
  158. ColorValues[38] := clBtnHighlight;
  159. end;
  160.  
  161. procedure TLabelEditorDlg.setTheLabelStyle(Value: TLabelStyle);
  162.  
  163. begin
  164.   DefaultColorPallet;
  165.   FLabelStyle := Value;
  166.   fAngle := Value.Angle;
  167.   degree.Caption := IntTOStr(fAngle);
  168.   TheAngle.Position := fAngle;
  169.   FA3DEffect := Value.AStyle3D;
  170.   FhOffSet := Value.AHShadeOffSet;
  171.   FvOffSet := Value.AVShadeOffSet;
  172.   FShadowColor := Value.AShadeRightBottom;
  173.   FWhiteColor := Value.AShadeLeftTop;
  174.   FShadeLTSet := Value.AShadeLTSet;
  175.   FLabelStyle.Angle  := value.Angle;
  176.  
  177.   degree.Caption := IntTOStr(value.Angle);
  178.   ShadeH.Value := Value.AHShadeOffSet;
  179.   ShadeV.Value := Value.AVShadeOffSet;
  180.  
  181.   RBResetWhite.Checked := Value.AShadeLTSet;
  182.   Case Value.AStyle3D of
  183.     A3dNormal   : RBNormal.Checked := true;
  184.     A3dResit    : RBResit.Checked := true;
  185.     A3dRaised   : RBRaised.Checked := true;
  186.     A3dShadowed : RBShadowed.Checked := true;
  187.   end;
  188. end;
  189.  
  190. procedure TLabelEditorDlg.TheAngleScroll(Sender: TObject;
  191.   ScrollCode: TScrollCode; var ScrollPos: Integer);
  192. begin
  193.   if ScrollPos = 360 then
  194.     ScrollPos := 0;
  195.   SetTheAngle(ScrollPos);
  196.   degree.Caption := IntTOStr(ScrollPos);
  197. end;
  198.  
  199. procedure TLabelEditorDlg.SetTheAngle(Value: longint);
  200. begin
  201.    FLabelStyle.Angle  := value;
  202. end;
  203.  
  204. procedure TLabelEditorDlg.SetTheFhOffSet(value: integer);
  205. begin
  206.   FLabelStyle.AHShadeOffSet  := value;
  207. end;
  208.  
  209. procedure TLabelEditorDlg.SetTheFvOffSet(value: integer);
  210. begin
  211.   FLabelStyle.AVShadeOffSet  := value;
  212. end;
  213.  
  214. procedure TLabelEditorDlg.SetTheShadeLT(value: boolean);
  215. begin
  216.    FLabelStyle.AShadeLTSet := value;
  217. end;
  218.  
  219. procedure TLabelEditorDlg.RBResetWhiteClick(Sender: TObject);
  220. begin
  221.    if RBResetWhite.Checked then
  222.       SetTheShadeLT(True)
  223.    else
  224.       SetTheShadeLT(false);
  225. end;
  226.  
  227. procedure TLabelEditorDlg.SetTheShadowColor(Value:TColor);
  228. begin
  229.    FLabelStyle.AShadeRightBottom := value;
  230. end;
  231.  
  232. procedure TLabelEditorDlg.SetTheWhiteColor(Value:TColor);
  233. begin
  234.   FLabelStyle.AShadeLeftTop := value;
  235. end;
  236.  
  237. procedure TLabelEditorDlg.ShadowColorsChange(Sender: TObject);
  238. begin
  239.   if ShadowChoice.ItemIndex = 1 then
  240.     SetTheShadowColor(ColorValues[ShadowColors.ItemIndex])
  241.   else
  242.     SetTheWhiteColor(ColorValues[ShadowColors.ItemIndex]);
  243. end;
  244.  
  245. procedure TLabelEditorDlg.setTheStyleEffect(Value : T3DEffectShort);
  246. begin
  247.   FLabelStyle.AStyle3D := value;
  248. end;
  249.  
  250. procedure TLabelEditorDlg.RBNormalClick(Sender: TObject);
  251. begin
  252.   setTheStyleEffect(A3dNormal);
  253. end;
  254.  
  255. procedure TLabelEditorDlg.RBRaisedClick(Sender: TObject);
  256. begin
  257.  setTheStyleEffect(A3dRaised);
  258. end;
  259.  
  260. procedure TLabelEditorDlg.RBResitClick(Sender: TObject);
  261. begin
  262.   setTheStyleEffect(A3dResit);
  263. end;
  264.  
  265. procedure TLabelEditorDlg.RBShadowedClick(Sender: TObject);
  266. begin
  267.   setTheStyleEffect(A3dShadowed);
  268. end;
  269.  
  270. procedure TLabelEditorDlg.BitBtnCancelClick(Sender: TObject);
  271.  
  272. begin
  273.   SetTheAngle(fAngle);
  274.   degree.Caption := IntTOStr(fAngle);
  275.   TheAngle.Position := fAngle;
  276.  
  277.   setTheStyleEffect(FA3DEffect);
  278.   Case FA3DEffect of
  279.     A3dNormal   : RBNormal.Checked := true;
  280.     A3dResit    : RBResit.Checked := true;
  281.     A3dRaised   : RBRaised.Checked := true;
  282.     A3dShadowed : RBShadowed.Checked := true;
  283.   end;
  284.  
  285.   SetTheShadowColor(FShadowColor);
  286.   SetTheWhiteColor(FWhiteColor);
  287.  
  288.   SetTheShadeLT(FShadeLTSet);
  289.   RBResetWhite.Checked := FShadeLTSet;
  290.  
  291.   SetTheFhOffSet(FhOffSet);
  292.   SetTheFvOffSet(FvOffSet);
  293.   ShadeH.Value := FhOffSet;
  294.   ShadeV.Value := FvOffSet;
  295. end;
  296.  
  297. procedure TLabelEditorDlg.ShadeVChange(Sender: TObject);
  298. begin
  299.    SetTheFvOffSet(ShadeV.Value);
  300. end;
  301.  
  302. procedure TLabelEditorDlg.ShadeHChange(Sender: TObject);
  303. begin
  304.    SetTheFhOffSet(ShadeH.Value);
  305. end;
  306.  
  307. procedure TLabelEditorDlg.MyLabelRotate1Click(Sender: TObject);
  308. begin
  309.   if ByLabel.Visible = false then
  310.     ByLabel.Visible := true
  311.   else
  312.     ByLabel.Visible := false;
  313. end;
  314.  
  315. end.
  316.